home comics writing pictures archive about

Vector.cls

Language: Visual Basic Class
Last Modified: 2020-06-27 1:58:30 PM UTC
File Size: 2873 bytes
http://www.penguinstew.ca/example/ExcelSQLExport/Vector.cls
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
END
Attribute VB_Name = "Vector"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Private m_vectorArray() As Variant
Private m_size As Integer
Private m_typeName As String
Public count As Integer
Private Sub Class_Initialize()
m_size = 15
Me.count = 0
ReDim m_vectorArray(m_size)
End Sub
Public Sub SetType(ByVal typeVar As Variant)
If Not m_typeName = "" Then
Err.Raise vbVariantError + 516, "Vector.SetType", "Vector type already set"
End If
m_typeName = typeName(typeVar)
End Sub
Public Sub Add(ByRef value As Variant)
If m_typeName = "" Then
Err.Raise vbVariantError + 514, "Vector.Add", "Vector type uninitialized"
End If
If Not m_typeName = typeName(value) Then
Err.Raise vbVariantError + 515, "Vector.Add", "Value type mismatch"
End If
If Me.count = m_size Then
m_size = m_size * 2
ReDim Preserve m_vectorArray(m_size)
End If
If IsObject(value) Then
Set m_vectorArray(Me.count) = value
Else
m_vectorArray(Me.count) = value
End If
Me.count = Me.count + 1
End Sub
Public Sub SetAt(ByVal index As Integer, ByRef value As Variant)
If m_typeName = "" Then
Err.Raise vbVariantError + 514, "Vector.Add", "Vector type uninitialized"
End If
If Not m_typeName = typeName(value) Then
Err.Raise vbVariantError + 515, "Vector.Add", "Value type mismatch"
End If
If index < Me.count Then
If IsObject(value) Then
Set m_vectorArray(index) = value
Else
m_vectorArray(index) = value
End If
Else
Err.Raise vbVariantError + 513, "Vector.SetAt", "Index out of range: " & index
End If
End Sub
Public Function GetAt(ByVal index As Integer) As Variant
If index < Me.count Then
If IsObject(m_vectorArray(index)) Then
Set GetAt = m_vectorArray(index)
Else
GetAt = m_vectorArray(index)
End If
Else
Err.Raise vbVariantError + 513, "Vector.GetAt", "Index out of range: " & index
End If
End Function
Public Sub Remove(ByVal index As Integer)
If index < Me.count Then
For i = index To Me.count - 1
If IsObject(m_vectorArray(index)) Then
Set m_vectorArray(i) = m_vectorArray(i + 1)
Else
m_vectorArray(i) = m_vectorArray(i + 1)
End If
Next i
Me.count = Me.count - 1
Else
Err.Raise vbVariantError + 513, "Vector.Remove", "Index out of range: " & index
End If
End Sub
Public Function IsEmpty() As Boolean
IsEmpty = Me.count <= 0
End Function
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103